<html>
<head>
<title>E:\QProjects\Lisp\toygen\inter\ast-core.lisp.html</title>
<meta name="Generator" content="Vim/7.0">
<meta http-equiv="content-type" content="text/html; charset=windows-1251">
</head>
<body bgcolor="#ffffff" text="#000000">
<pre>
<font color="#804040"> 1 </font><span class="Comment">;</span>
<font color="#804040"> 2 </font><span class="Comment">; defines ast-manipulation routines</span>
<font color="#804040"> 3 </font><span class="Comment">; the most important are:</span>
<font color="#804040"> 4 </font><span class="Comment">;     process-ast-list</span>
<font color="#804040"> 5 </font><span class="Comment">;     def-ast-handler</span>
<font color="#804040"> 6 </font>
<font color="#804040"> 7 </font>
<font color="#804040"> 8 </font><span class="Special">(</span><span class="Statement">defparameter</span><span class="lispList"> </span><span class="Type">*module-ast-mappings*</span><span class="lispList"> </span><span class="Special">(</span><span class="Statement">make-hash-table</span><span class="Special">))</span>
<font color="#804040"> 9 </font>
<font color="#804040">10 </font><span class="Comment">;</span>
<font color="#804040">11 </font><span class="Comment">; defines a base class used in order to represent error information</span>
<font color="#804040">12 </font><span class="Comment">;</span>
<font color="#804040">13 </font><span class="Special">(</span><span class="Statement">define-condition</span><span class="lispList"> </span><span class="lispSymbol">ast-error</span><span class="lispList"> </span><span class="Special">(</span><span class="Statement">error</span><span class="Special">)</span>
<font color="#804040">14 </font><span class="lispLeadWhite">  </span><span class="Special">(</span>
<font color="#804040">15 </font><span class="lispLeadWhite">   </span><span class="Special">(</span><span class="lispSymbol">text</span><span class="lispList"> </span><span class="lispSymbol">:initarg</span><span class="lispList"> </span><span class="lispSymbol">:text</span><span class="lispList"> </span><span class="lispSymbol">:reader</span><span class="lispList"> </span><span class="lispSymbol">text</span><span class="Special">)</span>
<font color="#804040">16 </font><span class="lispLeadWhite">   </span><span class="Special">))</span>
<font color="#804040">17 </font>
<font color="#804040">18 </font><span class="Comment">;</span>
<font color="#804040">19 </font><span class="Comment">; defines &quot;exception&quot; class that is used in order to represent</span>
<font color="#804040">20 </font><span class="Comment">; errors in filling malformed mapping's information</span>
<font color="#804040">21 </font><span class="Comment">;</span>
<font color="#804040">22 </font><span class="Special">(</span><span class="Statement">define-condition</span><span class="lispList"> </span><span class="lispSymbol">multiple-definition-error</span><span class="lispList"> </span><span class="Special">(</span><span class="lispSymbol">ast-error</span><span class="Special">)</span>
<font color="#804040">23 </font><span class="lispLeadWhite">  </span><span class="Special">(</span>
<font color="#804040">24 </font><span class="lispLeadWhite">   </span><span class="Special">(</span><span class="lispSymbol">entity</span><span class="lispList"> </span><span class="lispSymbol">:initarg</span><span class="lispList"> </span><span class="lispSymbol">:entity</span><span class="lispList"> </span><span class="lispSymbol">:reader</span><span class="lispList"> </span><span class="lispSymbol">entity</span><span class="Special">)</span>
<font color="#804040">25 </font><span class="lispLeadWhite">   </span><span class="Special">))</span>
<font color="#804040">26 </font>
<font color="#804040">27 </font><span class="Comment">;</span>
<font color="#804040">28 </font><span class="Comment">; defines exception that is used in order to represent</span>
<font color="#804040">29 </font><span class="Comment">; malformed type information</span>
<font color="#804040">30 </font><span class="Comment">;</span>
<font color="#804040">31 </font><span class="Special">(</span><span class="Statement">define-condition</span><span class="lispList"> </span><span class="lispSymbol">malformed-type-error</span><span class="lispList"> </span><span class="Special">(</span><span class="lispSymbol">ast-error</span><span class="Special">)</span>
<font color="#804040">32 </font><span class="lispLeadWhite">  </span><span class="Special">(</span>
<font color="#804040">33 </font><span class="lispLeadWhite">   </span><span class="Special">(</span><span class="lispSymbol">type-spec</span><span class="lispList"> </span><span class="lispSymbol">:initarg</span><span class="lispList"> </span><span class="lispSymbol">:type-spec</span><span class="lispList"> </span><span class="lispSymbol">:reader</span><span class="lispList"> </span><span class="lispSymbol">type-spec</span><span class="Special">)</span>
<font color="#804040">34 </font><span class="lispLeadWhite">   </span><span class="Special">))</span>
<font color="#804040">35 </font>
<font color="#804040">36 </font><span class="Comment">;</span>
<font color="#804040">37 </font><span class="Comment">; maps function to symbol</span>
<font color="#804040">38 </font><span class="Comment">;</span>
<font color="#804040">39 </font><span class="Special">(</span><span class="Statement">defmacro</span><span class="lispList"> </span><span class="lispSymbol">add-mapping</span><span class="lispList"> </span><span class="Special">(</span><span class="Statement">symbol</span><span class="lispList"> </span><span class="Statement">function</span><span class="Special">)</span>
<font color="#804040">40 </font><span class="lispLeadWhite">  </span><span class="PreProc">`(</span><span class="Statement">progn</span>
<font color="#804040">41 </font><span class="lispLeadWhite">    </span><span class="Special">(</span><span class="Statement">check-type</span><span class="lispList"> ,</span><span class="Statement">symbol</span><span class="lispList"> </span><span class="Statement">symbol</span><span class="Special">)</span>
<font color="#804040">42 </font><span class="lispLeadWhite">    </span><span class="Special">(</span><span class="Statement">check-type</span><span class="lispList"> ,</span><span class="Statement">function</span><span class="lispList"> </span><span class="Statement">function</span><span class="Special">)</span>
<font color="#804040">43 </font><span class="lispLeadWhite">    </span><span class="Special">(</span><span class="Statement">if</span><span class="lispList"> </span><span class="Special">(</span><span class="Statement">gethash</span><span class="lispList"> ,</span><span class="Statement">symbol</span><span class="lispList"> </span><span class="Type">*module-ast-mappings*</span><span class="Special">)</span>
<font color="#804040">44 </font><span class="lispLeadWhite">    </span><span class="Special">(</span><span class="Statement">error</span><span class="lispList"> </span><span class="Special">'</span><span class="Identifier">multiple-definition-error</span>
<font color="#804040">45 </font><span class="lispLeadWhite">               </span><span class="lispSymbol">:text</span><span class="lispList"> </span><span class="Constant">&quot;symbol is already defined&quot;</span><span class="lispList"> </span><span class="lispSymbol">:entity</span><span class="lispList"> ,</span><span class="Statement">symbol</span><span class="Special">))</span>
<font color="#804040">46 </font><span class="lispLeadWhite">    </span><span class="Special">(</span><span class="Statement">setf</span><span class="lispList"> </span><span class="Special">(</span><span class="Statement">gethash</span><span class="lispList"> ,</span><span class="Statement">symbol</span><span class="lispList"> </span><span class="Type">*module-ast-mappings*</span><span class="Special">)</span><span class="lispList"> ,</span><span class="Statement">function</span><span class="Special">)</span><span class="PreProc">)</span>
<font color="#804040">47 </font><span class="lispLeadWhite">  </span><span class="Special">)</span>
<font color="#804040">48 </font>
<font color="#804040">49 </font><span class="Special">(</span><span class="Statement">defun</span><span class="lispList"> </span><span class="lispSymbol">transform-ast-arg-list</span><span class="lispList"> </span><span class="Special">(</span><span class="lispSymbol">arg-list</span><span class="Special">)</span>
<font color="#804040">50 </font><span class="lispLeadWhite">  </span><span class="Special">(</span><span class="Statement">mapcar</span><span class="lispList"> </span><span class="lispSymbol">#</span><span class="Special">'</span><span class="Special">(</span><span class="Statement">lambda</span><span class="lispAtomList"> </span><span class="Special">(</span><span class="lispAtomList">sym</span><span class="Special">)</span>
<font color="#804040">51 </font><span class="lispLeadWhite">          </span><span class="Special">(</span><span class="Statement">cond</span>
<font color="#804040">52 </font><span class="lispLeadWhite">        </span><span class="Special">((</span><span class="Statement">listp</span><span class="lispAtomList"> sym</span><span class="Special">)</span><span class="lispAtomList"> </span><span class="Special">(</span><span class="Statement">append</span><span class="lispAtomList"> '</span><span class="Special">(</span><span class="Statement">list</span><span class="Special">)</span><span class="lispAtomList"> </span><span class="Special">(</span><span class="lispAtomList">transform-ast-arg-list sym</span><span class="Special">)))</span>
<font color="#804040">53 </font><span class="lispLeadWhite">        </span><span class="Special">((</span><span class="Statement">symbolp</span><span class="lispAtomList"> sym</span><span class="Special">)</span><span class="lispAtomList"> </span><span class="Special">(</span><span class="Statement">list</span><span class="lispAtomList"> '</span><span class="Statement">quote</span><span class="lispAtomList"> sym</span><span class="Special">))</span>
<font color="#804040">54 </font><span class="lispLeadWhite">        </span><span class="Special">(</span><span class="Statement">t</span><span class="lispAtomList"> sym</span><span class="Special">)</span>
<font color="#804040">55 </font><span class="lispLeadWhite">        </span><span class="Special">))</span>
<font color="#804040">56 </font><span class="lispLeadWhite">      </span><span class="lispSymbol">arg-list</span><span class="Special">))</span>
<font color="#804040">57 </font>
<font color="#804040">58 </font><span class="Special">(</span><span class="Statement">defun</span><span class="lispList"> </span><span class="lispSymbol">process-ast-list</span><span class="lispList"> </span><span class="Special">(</span><span class="lispSymbol">ast-context</span><span class="lispList"> </span><span class="lispSymbol">ast-list</span><span class="Special">)</span>
<font color="#804040">59 </font><span class="lispLeadWhite">  </span><span class="Special">(</span><span class="Statement">let</span><span class="lispList"> </span><span class="Special">((</span><span class="lispSymbol">ast-handler</span><span class="lispList"> </span><span class="Special">(</span><span class="Statement">gethash</span><span class="lispList"> </span><span class="Special">(</span><span class="Statement">first</span><span class="lispList"> </span><span class="lispSymbol">ast-list</span><span class="Special">)</span><span class="lispList"> </span><span class="Type">*module-ast-mappings*</span><span class="Special">)))</span>
<font color="#804040">60 </font><span class="lispLeadWhite">    </span><span class="Special">(</span><span class="Statement">unless</span><span class="lispList"> </span><span class="lispSymbol">ast-handler</span><span class="lispList"> </span><span class="Special">(</span><span class="Statement">error</span><span class="lispList"> </span><span class="Constant">&quot;ast-handler is omitted&quot;</span><span class="Special">))</span>
<font color="#804040">61 </font>
<font color="#804040">62 </font><span class="lispLeadWhite">    </span><span class="Comment">; catch errors while evaluating ast functions</span>
<font color="#804040">63 </font><span class="lispLeadWhite">    </span><span class="Special">(</span><span class="Statement">handler-case</span>
<font color="#804040">64 </font><span class="lispLeadWhite">    </span><span class="Special">(</span><span class="Statement">eval</span><span class="lispList"> </span><span class="Special">(</span><span class="Statement">append</span>
<font color="#804040">65 </font><span class="lispLeadWhite">           </span><span class="Special">(</span><span class="Statement">list</span><span class="lispList"> </span><span class="Special">'</span><span class="Identifier">funcall</span><span class="lispList"> </span><span class="lispSymbol">ast-handler</span><span class="lispList"> </span><span class="lispSymbol">ast-context</span><span class="Special">)</span>
<font color="#804040">66 </font><span class="lispLeadWhite">           </span><span class="Special">(</span><span class="lispSymbol">transform-ast-arg-list</span><span class="lispList"> </span><span class="Special">(</span><span class="Statement">cdr</span><span class="lispList"> </span><span class="lispSymbol">ast-list</span><span class="Special">))</span>
<font color="#804040">67 </font><span class="lispLeadWhite">           </span><span class="Special">))</span>
<font color="#804040">68 </font><span class="lispLeadWhite">      </span><span class="Special">(</span><span class="Statement">error</span><span class="lispList"> </span><span class="Special">(</span><span class="lispSymbol">error-instance</span><span class="Special">)</span>
<font color="#804040">69 </font><span class="lispLeadWhite">    </span><span class="Special">(</span><span class="Statement">format</span><span class="lispList"> </span><span class="Statement">t</span>
<font color="#804040">70 </font><span class="lispLeadWhite">        </span><span class="Constant">&quot;error while evaluating ast function ~a at location ~a~%&quot;</span>
<font color="#804040">71 </font><span class="lispLeadWhite">        </span><span class="Special">(</span><span class="Statement">first</span><span class="lispList"> </span><span class="lispSymbol">ast-list</span><span class="Special">)</span>
<font color="#804040">72 </font><span class="lispLeadWhite">        </span><span class="Constant">&quot;TODO: implement location&quot;</span><span class="Special">)</span>
<font color="#804040">73 </font><span class="lispLeadWhite">    </span><span class="Comment">;(describe error-instance)</span>
<font color="#804040">74 </font>
<font color="#804040">75 </font><span class="lispLeadWhite">    </span><span class="Comment">; throw the same error again</span>
<font color="#804040">76 </font><span class="lispLeadWhite">    </span><span class="Special">(</span><span class="Statement">error</span><span class="lispList"> </span><span class="lispSymbol">error-instance</span><span class="Special">)</span>
<font color="#804040">77 </font><span class="lispLeadWhite">    </span><span class="Special">)</span>
<font color="#804040">78 </font><span class="lispLeadWhite">      </span><span class="Special">)</span>
<font color="#804040">79 </font><span class="lispLeadWhite">    </span><span class="Special">))</span>
<font color="#804040">80 </font>
<font color="#804040">81 </font><span class="Special">(</span><span class="Statement">defmacro</span><span class="lispList"> </span><span class="lispSymbol">def-ast-handler</span><span class="lispList"> </span><span class="Special">(</span><span class="lispSymbol">ast-name</span><span class="lispList"> </span><span class="lispSymbol">args</span><span class="lispList"> </span><span class="lispSymbol">&amp;rest</span><span class="lispList"> </span><span class="lispSymbol">body</span><span class="Special">)</span>
<font color="#804040">82 </font><span class="lispLeadWhite">  </span><span class="PreProc">`(</span><span class="lispSymbol">add-mapping</span><span class="lispBQList"> </span><span class="Special">'</span><span class="Identifier">,ast-name</span>
<font color="#804040">83 </font><span class="lispLeadWhite">    </span><span class="Special">(</span><span class="Statement">lambda</span><span class="lispList"> ,</span><span class="lispSymbol">args</span>
<font color="#804040">84 </font><span class="lispLeadWhite">      </span><span class="Comment">;(format t &quot;ast-handler~%&quot;)</span>
<font color="#804040">85 </font><span class="lispLeadWhite">      </span><span class="lispList">,</span><span class="lispSymbol">@body</span><span class="Special">)</span><span class="PreProc">)</span>
<font color="#804040">86 </font><span class="lispLeadWhite">  </span><span class="Special">)</span>
</pre>
</body>
</html>
